'BLACKJACK
SCREEN 1,640,200,3,2
WINDOW 2," BLACKJACK ",,16,1
BREAK ON
ON BREAK GOSUB terminate
OPTION BASE 1
DIM clubs%(100),diamonds%(100),hearts%(100),spades%(100),wvshp%(256)
DIM shoe(4,13)
DIM comp(8,3),play1(8,3),play2(8,3)
GOSUB dfwave
GOSUB setcolors
GOSUB titlepage
setup:
  CLS:LINE(192,32)-(440,152),1,bf
  COLOR 2,3
  LOCATE 6,26:PRINT "        OPTIONS MENU         "
  COLOR 3,2
  LOCATE 8,26:PRINT " 0) HOUSE RULES              "
  LOCATE 10,26:PRINT " 1) DEAL 1 DECK SHOES        "
  LOCATE 12,26:PRINT " 2) DEAL 2 DECK SHOES        "
  LOCATE 14,26:PRINT " 3) DEAL 3 DECK SHOES        "
  LOCATE 16,26:PRINT " 4) DEAL 4 DECK SHOES        "
  COLOR 2,3
  LOCATE 18,26:PRINT " SELECT NUMBER OR USE MOUSE  " 
  mouseclear=MOUSE(0)
  GOSUB startselect
  COLOR 1,0:CLS
  IF qa$="0" THEN
    GOSUB instructions
    GOTO setup
  END IF
  decks=VAL(qa$)
  CLS
  totcards=decks*52
  playbet=0:handsdealt=0
  playmoney=10000
  compmoney=100000
  handbin=0:hand2bin=0
newshoe:
  GOSUB shuffle
sameshoe:
  GOSUB takebet
  GOSUB dealcards
  GOSUB totalhands
  GOSUB displaytext
  GOSUB player
  GOSUB computer
  GOSUB results
  handsdealt=handsdealt+1
  IF compmoney=0 THEN GOTO terminate
  IF playmoney=0 THEN GOTO terminate
  IF totcards-totdealt>7 THEN sameshoe :ELSE newshoe  
setcolors:
  PALETTE 0,0.4,0.77,0.3 ' green
  PALETTE 1,0,0,0 ' black
  PALETTE 2,1,1,1 ' white
  PALETTE 3,0.93,0.2,0 'red
  PALETTE 4,1,1,0.13 ' yellow
  PALETTE 5,0.4,0.6,1 'blue
  PALETTE 6,0,0.93,0.87 'aqua
  PALETTE 7,0.53,0.53,0.53 'grey
RETURN
terminate:
  COLOR 1,7:CLS:COLOR 2,1
  PRINT:PRINT
  IF compmoney=0 THEN
    PRINT " CONGRATULATIONS YOU BROKE THE BANK !!!!!!! "
    PRINT:PRINT" NOW GO AWAY !!!!!!!! "
  ELSEIF playmoney=0 THEN
    PRINT" NO MONEY LEFT.........BYE SEE YA!!!!!!!! "
    PRINT:PRINT" COME BACK REAL SOON..........BRING CASH!!!!!!! "
  ELSE
    PRINT" QUITTER !!!!!!!!!!!!!"
  END IF
  PRINT:PRINT:COLOR 1,7
  PRINT " THERE WERE ";handsdealt;"HANDS PLAYED"
  FOR x=1 TO 15000:NEXT x 
  WINDOW CLOSE 2
  SCREEN CLOSE 1
  PALETTE 0,0.2,0.3,0.5
  PALETTE 1,1,1,1
  PALETTE 2,0,0,0
  PALETTE 3,0.9,0.59,0
  CLS
END
titlepage:
  COLOR 1,0:CLS
  LINE(18,8)-(540,152),,b:PAINT(28,28),4,1
  LINE(144,64)-(416,96),,b:PAINT(154,71),1,1
  COLOR 3,2
  LOCATE 10,28:PRINT " ' BLACKJACK ' "
  COLOR 1,0
  whohand=1
  suit=4:card=11:whatcard=0:GOSUB drwcrd:x1=38:y1=33:GOSUB spade
  suit=3:card=1:whatcard=1:GOSUB drwcrd:x1=101:y1=31:GOSUB heart
  suit=1:card=11:whatcard=6:GOSUB drwcrd:x1=424:y1=30:GOSUB club
  suit=2:card=1:whatcard=7:GOSUB drwcrd:x1=489:y1=29:GOSUB diamond
  whohand=2
  suit=2:card=11:whatcard=0:GOSUB drwcrd:x1=41:y1=101:GOSUB diamond
  suit=1:card=1:whatcard=1:GOSUB drwcrd:x1=102:y1=102:GOSUB club
  suit=3:card=11:whatcard=6:GOSUB drwcrd:x1=421:y1=103:GOSUB heart
  suit=4:card=1:whatcard=7:GOSUB drwcrd:x1=486:y1=105:GOSUB spade
  GET (32,28)-(52,39),spades%
  GET (96,28)-(116,39),hearts%
  GET (416,28)-(436,39),clubs%
  GET (480,28)-(500,39),diamonds%
  FOR x=1 TO 5000: NEXT x
RETURN
club:
  CIRCLE(x1,y1),3,1:PAINT STEP (0,0),1,1
  CIRCLE STEP (-4,3),3,1:PAINT STEP (0,0),1,1
  CIRCLE STEP (8,0),3,1:PAINT STEP (0,0),1,1
  LINE STEP (-5,1) - STEP (2,2),,bf
  RETURN
diamond:
  COLOR 3,2
  AREA(x1,y1):AREA STEP(6,3):AREA STEP(-7,3):AREA STEP(-6,-3)
  AREAFILL
  COLOR 1,0
  RETURN
heart:
  COLOR 3,2
  CIRCLE(x1,y1),4,3:PAINT STEP(0,0),3,3
  CIRCLE STEP(8,0),4,3:PAINT STEP(0,0),3,3
  AREA STEP(4,0):AREA STEP(-8,4):AREA STEP(-8,-4)
  AREAFILL
  COLOR 1,0
  RETURN
spade:
  CIRCLE(x1,y1),4,1:PAINT STEP(0,0),1,1
  CIRCLE STEP(8,0),4,1:PAINT STEP(0,0),1,1
  AREA STEP(4,0):AREA STEP(-8,-4):AREA STEP(-8,4)
  AREAFILL
  LINE STEP(7,2) - STEP(2,2),,bf
  RETURN
instructions:
  COLOR 1,7:CLS:COLOR 2,1
  PRINT:PRINT:LOCATE 3,10
  PRINT " HOUSE RULES ":PRINT:COLOR 1,7
  PRINT:PRINT "  BLACKJACKS PAY ONE AND A HALF TIMES THE BET ON THE FIRST HAND ONLY"
  PRINT:PRINT "  DEALER HITS ON 16 OR LESS AND STAYS ON 17 OR MORE"
  PRINT:PRINT "  NO MONEY CHANGES HANDS ON A TIE"
  PRINT:PRINT "  YOU CAN SPLIT CARDS OF EQUAL VALUE ON THE FIRST HAND ONLY"
  PRINT:PRINT "  YOU CAN DOUBLE THE BET FOR ONE CARD ON THE FIRST HAND ONLY" 
  PRINT:PRINT "  HIT ENTER IN THE BET WINDOW TO REPEAT LAST BET VALUE"
  LOCATE 20,10:COLOR 2,1
  PRINT " CLICK LEFT MOUSE BUTTON TO CONTINUE "
  COLOR 1,0
  loop1:
  IF MOUSE(0)=0 THEN loop1
  RETURN
shuffle:
  RANDOMIZE TIMER
  FOR x=1 TO 4
  FOR z=1 TO 13
  shoe(x,z)=0
  NEXT z
  NEXT x
  totdealt=0
  GOSUB shuffsound
RETURN
takebet:
  WINDOW 3," BET ",(540,106)-(630,180),0,1
  COLOR 3,2
  ON BREAK GOSUB winowbreak
rebet:
  CLS
  lstcash=playmoney:lstbet=playbet
  PRINT
  PRINT " BANK ":PRINT "   ";compmoney
  PRINT
  PRINT " YOU  ":PRINT "   ";playmoney
  PRINT
  PRINT " ENTER BET"
  INPUT playbet$: playbet=VAL(playbet$)
  IF playbet$="" THEN playbet=lstbet
  IF playbet>playmoney OR playbet>compmoney OR playbet<1 THEN rebet
  playmoney=playmoney-playbet
  compmoney=compmoney-playbet
  handbin=2*playbet:hand2bin=0
  WINDOW CLOSE 3
  COLOR 1,0
  ON BREAK GOSUB terminate
RETURN
dealcards:
  CLS:prntmenu=1:blackjack=0
  bnkbusted=0:sbusted=0:double=0
  dealt=1:playdone=0:onecard=0:busted=0:split=0
redeal:
  IF totcards-totdealt<2 THEN GOSUB shuffle
  suit = INT((RND(1)*4)+1)
  card = INT((RND(1)*13)+1)
  IF shoe(suit,card)>=decks THEN redeal
  shoe(suit,card)=shoe(suit,card)+1
  cvalue=card
  IF cvalue>10 THEN cvalue=10
  IF cvalue=1 THEN cvalue=11
  IF onecard =1 THEN RETURN
  IF dealt=1 THEN
    play1(1,1)=suit:play1(1,2)=card:play1(1,3)=cvalue
    whohand=2:whatcard=0:GOSUB drwcrd
  END IF
  IF dealt=2 THEN
    comp(1,1)=suit:comp(1,2)=card:comp(1,3)=cvalue
    whohand=1:whatcard=0:GOSUB drwcrd
  END IF
  IF dealt=3 THEN
    play1(2,1)=suit:play1(2,2)=card:play1(2,3)=cvalue
    whohand=2:whatcard=1:GOSUB drwcrd
  END IF
  IF dealt=4 THEN
    comp(2,1)=suit:comp(2,2)=card:comp(2,3)=cvalue
    LINE(96,28)-(144,60),,b:SOUND 20,1,255,1
    PAINT(106,38),5,1
  END IF
  dealt=dealt+1
  IF dealt <5 THEN redeal
  totdealt=totdealt+4
  play1dealt=2
  play2dealt=0
  compdealt=2
RETURN
totalhands:
  play1tot=0:play2tot=0:comptot=0
  FOR x=1 TO play1dealt
  play1tot = play1tot + play1(x,3)
  NEXT x
  FOR x=1 TO compdealt
  comptot = comptot + comp(x,3)
  NEXT x
  IF play2dealt = 0 THEN RETURN
  FOR x=1 TO play2dealt
  play2tot = play2tot + play2(x,3)
  NEXT x
  RETURN
displaytext:
  COLOR 1,0
  IF prntmenu=1 THEN
    LOCATE 3,5:PRINT "COMPUTER HAND:     TOTAL = "
    LOCATE 12,5:PRINT "PLAYER HAND #1:    TOTAL = "
    LOCATE 19,5:PRINT "PLAYER HAND #2:    TOTAL = "
    LOCATE 3,45:PRINT "LAST BET =  "
    LOCATE 12,45:PRINT "LAST CASH = "
    LINE(540,0)-(635,88),,b:PAINT(550,20),3,1
    COLOR 2,1
    LOCATE 2,70:PRINT " OPTIONS "
    COLOR 1,4
    LOCATE 4,70:PRINT "(S) STAND"
    LOCATE 6,70:PRINT "(H) HIT  "
    LOCATE 8,70:PRINT "(D) DBLE "
    LOCATE 10,70:PRINT "(X) SPLIT"
    COLOR 1,0:prntmenu=0
  END IF
  LOCATE 12,32:PRINT play1tot;"    "
  LOCATE 3,57:PRINT playbet;"    "
  LOCATE 12,57:PRINT lstcash;"    "
  IF playdone=1 THEN LOCATE 3,32:PRINT comptot;"    "
  IF play2dealt=0 THEN RETURN
  LOCATE 19,32:PRINT play2tot;"    "
  RETURN  
player:
  IF comptot=21 AND play1tot<> 21 THEN RETURN
  IF play1tot=21 AND play1dealt=2 AND split=0 THEN
    IF comptot <> 21 THEN
      handbin=handbin+0.5*playbet
      compmoney=compmoney-0.5*playbet
      blackjack=1
      RETURN
    END IF
   RETURN
  END IF
  IF play1tot>21 AND play1dealt=2 GOTO doubleace
  GOSUB imouser
  IF qa$="s" THEN RETURN
  IF qa$="h" THEN
doubleit:
    onecard=1:GOSUB redeal
    play1dealt=play1dealt+1:totdealt=totdealt+1
    play1(play1dealt,1)=suit:play1(play1dealt,2)=card:play1(play1dealt,3)=cvalue
    whohand=2:whatcard=play1dealt-1:GOSUB drwcrd
    GOSUB totalhands
doubleace:
    IF play1tot > 21 THEN
      switch=0:busted=1
      FOR x=1 TO play1dealt
      IF play1(x,2)=1 AND play1(x,3)=11 AND switch=0 THEN
        play1(x,3)=1:play1tot=play1tot-10:switch=1:busted=0
      END IF
      NEXT x
    END IF
    GOSUB displaytext
    IF busted=1 THEN
      COLOR 1,3:LOCATE 13,8
      PRINT " BUSTED "
      COLOR 1,0
      RETURN
    END IF
    IF double =1 THEN RETURN
    GOTO player
  END IF
  IF qa$="d" AND playmoney>=playbet AND play1dealt =2 AND split=0 THEN
    compmoney=compmoney-playbet
    playmoney=playmoney-playbet
    playbet=playbet*2
    handbin=handbin*2
    double=1
    GOSUB doubleit
    RETURN
  END IF
  IF qa$="x" AND split=0 AND playmoney>=playbet AND play1dealt=2 THEN
    IF play1(1,3)<>play1(2,3)THEN
      IF play1(1,2)<>play1(2,2) THEN GOTO player
    END IF
    hand2bin=handbin:split=1
    compmoney=compmoney-playbet
    playmoney=playmoney-playbet
    play2(1,1)=play1(2,1):play2(1,2)=play1(2,2):play2(1,3)=play1(2,3)
    IF play1(1,2)=1 AND play1(1,3)=1 THEN play1(1,3)=11
    IF play2(1,2)=1 AND play2(1,3)=1 THEN play2(1,3)=11
    suit=play2(1,1):card=play2(1,2)
    whohand=3:whatcard=0
    GOSUB drwcrd
    onecard=1:GOSUB redeal
    play1(2,1)=suit:play1(2,2)=card:play1(2,3)=cvalue
    whohand=2:whatcard=1
    PAINT (106,110),0,0:GOSUB drwcrd
    onecard=1:GOSUB redeal
    play2(2,1)=suit:play(2,2)=card:play2(2,3)=cvalue
    whohand=3:whatcard=1
    GOSUB drwcrd
    totdealt=totdealt+2:play2dealt=2
    GOSUB totalhands
    GOSUB displaytext
  END IF    
  GOTO player
secondhand:
  IF play2tot>21 AND play2dealt=2 GOTO twinace
  GOSUB imouser
  IF qa$="s" THEN RETURN
  IF qa$="h" THEN
    onecard=1:GOSUB redeal
    play2dealt=play2dealt+1:totdealt=totdealt+1
    play2(play2dealt,1)=suit:play2(play2dealt,2)=card:play2(play2dealt,3)=cvalue
    whohand=3:whatcard=play2dealt-1:GOSUB drwcrd
    GOSUB totalhands
twinace:
    IF play2tot>21 THEN
      switch=0:sbusted=1
      FOR x=1 TO play2dealt
      IF play2(x,2)=1 AND play2(x,3)=11 AND switch=0 THEN
        play2(x,3)=1:play2tot=play2tot-10:switch=1:sbusted=0
      END IF
      NEXT x
    END IF
    GOSUB displaytext
    IF sbusted=1 THEN
      COLOR 1,3:LOCATE 20,8
      PRINT " BUSTED "
      COLOR 1,0
      RETURN
    END IF
    END IF
    GOTO secondhand  
computer:
  IF split=1 THEN BEEP:CIRCLE(22,160),6,3:PAINT(22,160),3,3:GOSUB secondhand
  playdone=1:whohand=1:whatcard=1
  suit=comp(2,1):card=comp(2,2)
  PAINT (106,38),0,1:GOSUB drwcrd
  IF blackjack=1 THEN GOSUB displaytext: RETURN
  IF comptot>21 AND compdealt=2 THEN dblace=1:GOTO twoaces
  GOSUB displaytext
  FOR x=1 TO 3000:NEXT x
adjusted:
  IF split=0 AND busted=1 THEN RETURN
  IF split=1 AND busted=1 AND sbusted=1 THEN RETURN
  WHILE (comptot<17)
    onecard=1:GOSUB redeal
    compdealt=compdealt+1:totdealt=totdealt+1
    comp(compdealt,1)=suit:comp(compdealt,2)=card:comp(compdealt,3)=cvalue
    whocard=1:whatcard=compdealt-1:GOSUB drwcrd
    GOSUB totalhands
twoaces:
    IF comptot>21 THEN
      switch=0:bnkbusted=1
      FOR x=1 TO compdealt
      IF comp(x,2)=1 AND comp(x,3)=11 AND switch=0 THEN
        comp(x,3)=1:comptot=comptot-10:switch=1:bnkbusted=0
      END IF
      NEXT x
    END IF
    GOSUB displaytext
    IF dblace=1 THEN dblace=0:GOTO adjusted
    FOR x = 1 TO 3000:NEXT x
  WEND
  IF bnkbusted=1 THEN LOCATE 4,8:COLOR 1,3:PRINT " BUSTED "
  COLOR 1,0
  RETURN
results:
  IF busted = 1 THEN
    compmoney=compmoney+handbin
  ELSEIF bnkbusted=1 THEN
    playmoney=playmoney+handbin
  ELSEIF comptot > play1tot THEN
    compmoney=compmoney+handbin
  ELSEIF play1tot>comptot THEN
    playmoney=playmoney+handbin
  ELSE
    playmoney=playmoney+playbet
    compmoney=compmoney+playbet
  END IF
  IF split <>0 THEN
    IF sbusted=1 THEN
      compmoney=compmoney+hand2bin
    ELSEIF bnkbusted=1 THEN
      playmoney=playmoney+hand2bin
    ELSEIF comptot>play2tot THEN
      compmoney=compmoney+hand2bin
    ELSEIF play2tot>comptot THEN
      playmoney=playmoney+hand2bin
    ELSE
      playmoney=playmoney+playbet
      compmoney=compmoney+playbet
    END IF
  END IF
  RETURN
imouser:
  qa$=""
  WHILE(qa$="")
    IF MOUSE(0)>0 THEN
      IF MOUSE(1)>552 AND MOUSE(1)<632 THEN
        IF MOUSE(2)>24 AND MOUSE(2)<32 THEN
          qa$="s"
        ELSEIF MOUSE(2)>40 AND MOUSE(2)<48 THEN
          qa$="h"
        ELSEIF MOUSE(2)>56 AND MOUSE(2)<64 THEN
          qa$="d"
        ELSEIF MOUSE(2)>72 AND MOUSE(2)<80 THEN
          qa$="x"
        ELSE
          qa$=""
        END IF
      END IF
    END IF
    IF qa$="" THEN qa$=INKEY$
  WEND
  RETURN
startselect:
  qa$=""
  WHILE(qa$="")
    IF MOUSE(0)>0 THEN
      IF MOUSE(1)>200 AND MOUSE(1)<432 THEN
        IF MOUSE(2)>56 AND MOUSE(2)<64 THEN
          qa$="0"
        ELSEIF MOUSE(2)>72 AND MOUSE(2)<80 THEN
          qa$="1"
        ELSEIF MOUSE(2)>88 AND MOUSE(2)<96 THEN
          qa$="2"
        ELSEIF MOUSE(2)>104 AND MOUSE(2)<112 THEN
          qa$="3"
        ELSEIF MOUSE(2)>120 AND MOUSE(2)<128 THEN
          qa$="4"  
        ELSE
          qa$=""
        END IF
      END IF
    END IF
    IF qa$="" THEN qa$=INKEY$
  WEND
  RETURN
drwcrd:
  IF suit=1 OR suit=4 THEN COLOR 1,0 :ELSE COLOR 3,0
  IF whohand=1 THEN
    y1=28:y2=60:numlin=6
  ELSEIF whohand=2 THEN
    y1=100:y2=132:numlin=15
  ELSE
    y1=156:y2=186:numlin=22
  END IF
  LINE(whatcard*64+32,y1)-(whatcard*64+80,y2),,b
  SOUND 20,1,255,1
  IF suit=1 OR suit=4 THEN
    PAINT (whatcard*64+42,y1+10),2,1
  ELSE
    PAINT (whatcard*64+42,y1+10),2,3
  END IF
  IF suit=1 THEN
    COLOR 1,2:PUT (whatcard*64+32,y1),clubs%,PSET
  ELSEIF suit=2 THEN
    COLOR 3,2:PUT (whatcard*64+32,y1),diamonds%,PSET
  ELSEIF suit=3 THEN
    COLOR 3,2:PUT (whatcard*64+32,y1),hearts%,PSET
  ELSE
    COLOR 1,2:PUT (whatcard*64+32,y1),spades%,PSET
  END IF

  LOCATE numlin,whatcard*8+7
  GOSUB altchar
  COLOR 1,0
  RETURN
altchar:
  IF suit=2 OR suit=3 THEN
    COLOR 3,2
  ELSE
    COLOR 1,2
  END IF
  IF card>10 OR card=1 THEN
    IF card=11 THEN PRINT "J "
    IF card=12 THEN PRINT "Q "
    IF card =13 THEN PRINT "K "
    IF card=1 THEN PRINT "A "
  ELSE
    IF card=10 THEN
      PRINT RIGHT$(STR$(card),2)
    ELSE
      PRINT RIGHT$(STR$(card),1)+" "
    END IF
  END IF
  RETURN
dfwave:
  xvalue=127
  FOR xx=0 TO 15
  FOR yy=1 TO 16
  wvshp%(xx*16+yy)=xvalue
  NEXT yy
  xvalue=INT(xvalue*0.63)
  NEXT xx
  WAVE 1,wvshp%
  ERASE wvshp%
RETURN
shuffsound:
  FOR qq=1 TO 3
  FOR xx=1 TO 8
  SOUND 50,1,255,1
  FOR zz= 1 TO 140:NEXT zz
  NEXT xx
  FOR zz= 1 TO 1000:NEXT zz
  SOUND 40,1,255,1
  FOR zz= 1 TO 500:NEXT zz
  SOUND 40,1,255,1
  FOR zz= 1 TO 3000:NEXT zz
  NEXT qq
  RETURN
winowbreak:
  RETURN